MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 05 - 1989/05.01 Jan 89/FinderControls/CDEF texte

Text File | 1988-04-26 | 17.3 KB | 650 lines | [TEXT/PJMM]

{**********************************************}
{ Put this file in the CDEF Project after DAPasLib, MacTraps, ROM85lib and ROM85. }
{ Don't forget to "Use resource file" in "Run options" of menu "Project". }
{ This resource file must contain the WIND ,CNTL, MENU, ICN#, ICON, MDEF }
{ resources that the Shell Project needs together with the compiled CDEF resource. }

{ "Build and save as…" resource code of type CDEF and ID 128 in file "CDEF code" }
{**********************************************}
UNIT CDEF;

INTERFACE

    USES
        ROM85;

    FUNCTION Main (varCode : integer;
                                    theControl : ControlHandle;
                                    message : integer;
                                    param : longint) : longint;

IMPLEMENTATION

    CONST
        RestState = 0;
        SelectState = 1;
        OpenState = 2;
        SelectOpenState = 3;
        ThrownAwayState = 4;
        MenuReturnState = 5;

        movableBit = 1;
        doubleClickableBit = 2;
        trashBit = 3;
        menuBit = 4;
        varCodeBase = 200;        { bit-offset of end of varCode in ControlRecord }
        integerLength = 16;

    TYPE
        DataHandle = ^DataPointer;
        DataPointer = ^DataRecord;
        DataRecord = RECORD
                theIcon : handle;
                theMenu : MenuHandle;
            END;

    FUNCTION PopUpMenuSelect (menu : MenuHandle;
                                    top, left, popUpItem : integer) : longint;
    INLINE
        $A80B;


    PROCEDURE PlotDoubleIcon (theIcon : handle;
                                    State : integer;
                                    dstSquare : rect);

        VAR
            srcSquare : rect;
            data, mask, destBitMap, scratchBitMap : bitmap;
            theGrafPort : GrafPtr;
            LightGrayIcon, DarkGrayIcon : handle;

    BEGIN
        IF (theIcon <> NIL) THEN
            BEGIN
                SetRect(srcSquare, -16, -16, 16, 16);

                data.rowBytes := 4;
                data.baseAddr := ptr(theIcon^);
                data.bounds := srcSquare;

                mask.rowBytes := 4;
                mask.baseAddr := ptr(ord4(theIcon^) + 128);
                mask.bounds := srcSquare;

                GetPort(theGrafPort);
                destBitMap := theGrafPort^.portbits;
                CASE state OF
                    RestState :
                        BEGIN
                            CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
                            CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
                        END;
                    SelectState :
                        BEGIN
{ old finder : }
                            CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
                            CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
                            CopyBits(mask, destBitMap, srcSquare, dstSquare, srcXOr, NIL);
{ new finder would be : }
{CopyBits(mask, destBitMap, srcSquare, dstSquare, srcOr, nil);}
{CopyBits(data, destBitMap, srcSquare, dstSquare, srcBic, nil);}
                        END;
                    OpenState :
                        BEGIN
                            WITH scratchBitMap DO
                                BEGIN
                                    LightGrayIcon := GetIcon(128);
                                    BaseAddr := LightGrayIcon^;
                                    bounds := srcSquare;
                                    Rowbytes := 4;
                                END;
                            CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
                            CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
                        END;
                    SelectOpenState :
                        BEGIN
                            WITH scratchBitMap DO
                                BEGIN
                                    DarkGrayIcon := GetIcon(129);
                                    BaseAddr := DarkGrayIcon^;
                                    bounds := srcSquare;
                                    Rowbytes := 4;
                                END;
                            CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
                            CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
                        END;
                    OTHERWISE
                END;
            END
    END;                { of PlotDoubleIcon }

{ ***************************************************** }

    FUNCTION distance (startPt, endPt : point) : integer;
    BEGIN
        distance := abs(startPt.h - endPt.h) + abs(startPt.v - endPt.v);
    END;

    FUNCTION InsideIcon (myPoint : point;
                                    IconCenter : point;
                                    myIcon : handle) : boolean;
        VAR
            bitOffset : longint;
            scratchMap, dataMap, maskMap, sensitiveMap : bitmap;
            square : rect;
            x, y : integer;
        LABEL
            1;
    BEGIN
        HLock(myIcon);
        SetRect(square, 0, 0, 32, 32);
        WITH scratchMap DO
            BEGIN
                bounds := square;
                BaseAddr := NewPtr(128);
                IF MemError <> NoErr THEN
                    GOTO 1;
                RowBytes := 4;
            END;
        WITH sensitiveMap DO
            BEGIN
                bounds := square;
                BaseAddr := NewPtr(128);
                IF MemError <> NoErr THEN
                    GOTO 1;
                RowBytes := 4;
            END;
        WITH dataMap DO
            BEGIN
                bounds := square;
                BaseAddr := myIcon^;
                RowBytes := 4;
            END;
        WITH maskMap DO
            BEGIN
                bounds := square;
                BaseAddr := Ptr(ord4(myIcon^) + 128);
                RowBytes := 4;
            END;
        CopyBits(maskMap, scratchMap, square, square, srcCopy, NIL);
        CopyBits(dataMap, scratchMap, square, square, srcOr, NIL);
        CalcMask(scratchMap.baseAddr, sensitiveMap.baseAddr, 4, 4, 32, 2);
        x := myPoint.h - IconCenter.h + 16;
        y := myPoint.v - IconCenter.v + 16;
        IF NOT ((x IN [0..31]) AND (y IN [0..31])) THEN
            InsideIcon := false
        ELSE
            BEGIN
                bitOffset := x + 32 * y;
                InsideIcon := BitTst(sensitiveMap.baseAddr, bitOffset);
            END;
        HUnLock(myIcon);
        DisposPtr(scratchMap.baseAddr);
        DisposPtr(sensitiveMap.baseAddr);
1 :
        IF MemError <> NoErr THEN
            InsideIcon := false;
    END;


    FUNCTION DoubleClick (theControl : ControlHandle;
                                    startPt : point;
                                    startTime : longint;
                                    VarCode : integer;
                                    bounds : rect;
                                    VAR IconCenter : point) : boolean;
        VAR
            mouse : point;
            t : longint;
            d : integer;
            theEvent : EventRecord;
            DoubleClicked : boolean;

        PROCEDURE DragSquare (startPt : point;
                                        VAR IconCenter : point);
            VAR
                oldFrame, frame, bounds : rect;
                delta, mouse : point;
                theGrafPort : GrafPtr;
                grayPattern : pattern;
                theTrash : ControlHandle;

            PROCEDURE HighLightTrash (mouse : point);
                VAR
                    where : integer;
                    IconCenter : point;
                    OverFlownControl : ControlHandle;
            BEGIN
                where := FindControl(mouse, FrontWindow, OverFlownControl);
                HLock(GetResource('CDEF', 128));
                FrameRect(oldFrame);
                IF theTrash <> OverFlownControl THEN
{ the control the mouse overflyes is no more "theTrash" }
                    BEGIN
                        IF theTrash <> NIL THEN
{ the mouse has ended overflying a trash }
                            BEGIN
                                SetCtlValue(theTrash, GetCtlValue(theTrash) - 1);
                                HLock(theTrash^^.ContrlDefProc);
                            END;
                        IF (OverFlownControl <> NIL) THEN
                            IF BitTst(pointer(OverFlownControl^), varCodeBase - trashBit) AND (theControl <> OverFlownControl) THEN
{ the mouse begins overflying a trash }
                                BEGIN
                                    SetCtlValue(OverFlownControl, GetCtlValue(OverFlownControl) + 1);
                                    HLock(OverFlownControl^^.ContrlDefProc);
                                    theTrash := OverFlownControl;
                                END
                            ELSE
{ the mouse overflies something else than a trash }
                                theTrash := NIL
                        ELSE
{ the mouse doesn't overfly anything }
                            theTrash := NIL;
                    END;
            END;

        BEGIN                    { DragSquare }
            theTrash := NIL;
            StuffHex(@grayPattern, '55AA55AA55AA55AA');
            GetPort(theGrafPort);
            bounds := theGrafPort^.PortRect;
            InSetRect(bounds, 16, 16);
            delta := IconCenter;
            SubPt(startPt, delta);
            PenMode(PatXor);
            WITH IconCenter DO
                SetRect(oldFrame, h - 16, v - 16, h + 16, v + 16);
            PenPat(grayPattern);
            FrameRect(oldFrame);
{ instead of the surrounding square }
{ we could also drag the icon's data or mask frame }
            REPEAT
                GetMouse(mouse);
                IconCenter := mouse;
                AddPt(delta, IconCenter);
                WITH IconCenter, bounds DO
                    BEGIN
                        IF h < left THEN
                            h := left;
                        IF h > right - 1 THEN
                            h := right - 1;
                        IF v < top THEN
                            v := top;
                        IF v > bottom - 1 THEN
                            v := bottom - 1;
                    END;
                WITH IconCenter DO
                    SetRect(frame, h - 16, v - 16, h + 16, v + 16);
                IF NOT EqualRect(oldFrame, frame) THEN
                    BEGIN
                        HighLightTrash(mouse);
                        FrameRect(frame);
                        oldFrame := frame;
                    END;
            UNTIL NOT WaitMouseUp;
            FrameRect(frame);
            PenNormal;
        END;

    BEGIN                { DoubleClick }
        DoubleClicked := false;
        BEGIN
{ if doubleClickable or movable : }
            IF (BitTst(@varCode, integerLength - doubleClickableBit)) OR (BitTst(@varCode, integerLength - movableBit)) THEN
                REPEAT
                    GetMouse(mouse);
                    d := distance(startPt, mouse);
                UNTIL (NOT WaitMouseUp OR (d > 3));
            IF (d > 3) AND BitTst(@varCode, integerLength - movableBit) THEN
                DragSquare(startPt, IconCenter)
            ELSE IF BitTst(@varCode, integerLength - doubleClickableBit) THEN
                REPEAT
                    GetMouse(mouse);
                    d := distance(startPt, mouse);
                    t := TickCount - startTime;
                    IF GetNextEvent(MDownMask, theEvent) THEN
                        DoubleClicked := true;
                UNTIL DoubleClicked OR (d > 3) OR (t > GetDblTime);
            DoubleClick := DoubleClicked;
        END;
    END;

{ ***************************************************** }

    FUNCTION Main;

        VAR
{ color under the title : }
            whitePattern : pattern;

        PROCEDURE DoDrawCntl;
            VAR
                IconCenter, TextCenter : point;
                State, theLength, theHalfLength : integer;
                TextFrame, IconFrame : rect;
                myDataHandle : DataHandle;
        BEGIN
            State := GetCtlValue(theControl);

{ MenuReturnState is drawn like RestState, ThrownAwayState is not re-drawn : }

            IF State = MenuReturnState THEN
                State := RestState;
            IF ((State IN [RestState..SelectOpenState]) AND (theControl^^.ContrlVis <> 0)) THEN
                BEGIN
                    HLock(handle(theControl));
                    WITH theControl^^ DO
                        BEGIN
                            TextFont(geneva);
                            TextFace([]);
                            TextMode(SrcOr);
                            TextSize(9);
                            theLength := StringWidth(contrlTitle);
                            IF theLength < 32 THEN
                                theHalfLength := 16
                            ELSE
                                theHalfLength := theLength DIV 2;
                            WITH ContrlRect DO
                                SetPt(IconCenter, (right + left) DIV 2, (bottom - 12 + top) DIV 2);

{ recalculate the rectangle surrounding the whole control : }

                            WITH IconCenter, ContrlRect DO
                                BEGIN
                                    left := h - theHalfLength;
                                    top := v - 16;
                                    right := h + theHalfLength;
                                    bottom := v + 16 + 12;
                                END;

                            WITH IconCenter, IconFrame DO
                                BEGIN
                                    left := h - 16;
                                    top := v - 16;
                                    right := h + 16;
                                    bottom := v + 16;
                                END;

{ draw the icon-control's title : }

                            WITH IconCenter DO
                                SetPt(TextCenter, h, v + 26);
                            WITH TextCenter DO
                                SetRect(TextFrame, h - theLength DIV 2, v - 10, h + theLength DIV 2, v + 2);
                            StuffHex(@whitePattern, '0000000000000000');
                            FillRect(TextFrame, whitePattern);
                            WITH TextCenter DO
                                MoveTo(h - theLength DIV 2, v);
                            DrawString(contrlTitle);

{ draw the icon : }

                            myDataHandle := DataHandle(ContrlData);
                            HLock(myDataHandle^^.theIcon);
                            PlotDoubleIcon(myDataHandle^^.theIcon, State, IconFrame);
                            HUnLock(myDataHandle^^.theIcon);

                        END;
                    HUnLock(handle(theControl));
                END;
            Main := 0;
        END;

        PROCEDURE DoTestCntl;
            VAR
                IconCenter, mouse : point;
                myDataHandle : DataHandle;
        BEGIN
            HLock(handle(theControl));
            WITH theControl^^ DO
                BEGIN
                    SetPt(mouse, LoWord(param), HiWord(param));
                    IF PtInRect(mouse, ContrlRect) THEN
                        BEGIN
                            WITH ContrlRect DO
                                SetPt(IconCenter, (right + left) DIV 2, (bottom - 12 + top) DIV 2);
                            myDataHandle := DataHandle(ContrlData);
                            Main := ord4(InsideIcon(mouse, IconCenter, myDataHandle^^.theIcon));
                        END
                    ELSE
                        main := 0;
                END;
            HUnLock(handle(theControl));
        END;

        PROCEDURE DoCalcCRgns;
            CONST
                Lo3Bytes = $00FFFFFF;
            VAR
                IconFrame, TextFrame : rect;
                theTitle : Str255;
                theLength, theHalfLength, halfWay : integer;
        BEGIN
            GetCTitle(theControl, theTitle);
            theLength := StringWidth(theTitle);
            theHalfLength := theLength DIV 2;
            param := BitAnd(param, Lo3Bytes);
            IconFrame := theControl^^.ContrlRect;
            WITH IconFrame DO
                BEGIN
                    bottom := bottom - 12;
                    halfWay := (right + left) DIV 2;
                    left := halfWay - 16;
                    right := halfWay + 16;
                    SetRect(TextFrame, halfWay - theHalfLength, bottom, halfWay + theHalfLength, bottom + 12);
                END;
            OpenRgn;
            FrameRect(IconFrame);
            FrameRect(TextFrame);
            CloseRgn(RgnHandle(param));
            Main := 0;
        END;

        PROCEDURE DeselectExcept (theControl : ControlHandle);
            VAR
                myWindowPeek : WindowPeek;
                aControl : ControlHandle;
        BEGIN
            myWindowPeek := WindowPeek(theControl^^.ContrlOwner);
            aControl := myWindowPeek^.ControlList;
            WHILE aControl <> NIL DO
                BEGIN
                    IF (aControl <> theControl) THEN
                        BEGIN
                            IF (GetCtlValue(aControl) = 1) THEN
                                BEGIN
                                    SetCtlValue(aControl, 0);
                                    HLock(aControl^^.ContrlDefProc);
                                END
                            ELSE IF (GetCtlValue(aControl) = 3) THEN
                                BEGIN
                                    SetCtlValue(aControl, 2);
                                    HLock(aControl^^.ContrlDefProc);
                                END
                        END;
                    aControl := aControl^^.nextControl;
                END;
        END;

        PROCEDURE DoAutoTrack;
            VAR
                SavedClip, UpDateRegion : RgnHandle;
                PopUpMenuHdl : MenuHandle;
{MDEFPtr : Ptr;{ for debugging only }
                theTitle : Str255;
                choosenItem, dummy : longint;
                halfWay, theHalfLength, where : integer;
                oldCenter, IconCenter, mouse, MenuTitleCenter : point;
                theGrafPort : GrafPtr;
                theTrash : ControlHandle;
                myDataHandle : DataHandle;
                isAMenu, isDoubleClickable, isMovable : boolean;
        BEGIN
            isAMenu := BitTst(@varCode, integerLength - MenuBit);
            isDoubleClickable := BitTst(@varCode, integerLength - DoubleClickableBit);
            isMovable := BitTst(@varCode, integerLength - MovableBit);
            IF isAMenu OR isDoubleClickable OR isMovable THEN
                BEGIN
                    IF GetCtlValue(theControl) = OpenState THEN
                        SetCtlValue(theControl, SelectOpenState)
                    ELSE IF GetCtlValue(theControl) = RestState THEN
                        SetCtlValue(theControl, SelectState);
                    HLock(theControl^^.ContrlDefProc);
                END;
            DeselectExcept(theControl);
            GetMouse(mouse);
            WITH theControl^^.ContrlRect DO
                SetPt(IconCenter, (right + left) DIV 2, (bottom - 12 + top) DIV 2);
            oldCenter := IconCenter;
            GetPort(theGrafPort);

{ 1° : DOUBLE-CLICK }

            IF DoubleClick(theControl, mouse, TickCount, varCode, theGrafPort^.PortRect, IconCenter) THEN
                BEGIN
                    SetCtlValue(theControl, SelectOpenState);
                    HLock(theControl^^.ContrlDefProc);
                END

{ 2° : NO DRAGGING }

            ELSE IF EqualPt(oldCenter, IconCenter) THEN
                BEGIN

{ 2.1 : POPUPMENU }

                    IF isAMenu THEN
                        BEGIN
                            myDataHandle := DataHandle(theControl^^.ContrlData);
                            PopUpMenuHdl := myDataHandle^^.theMenu;

                            WITH theControl^^.ContrlRect, MenuTitleCenter DO
                                BEGIN
                                    h := (left + right) DIV 2;
                                    v := (top + bottom) DIV 2;
                                END;
                            LocalToGlobal(MenuTitleCenter);
                            WITH MenuTitleCenter DO
                                choosenItem := PopUpMenuSelect(PopUpMenuHdl, h, v, 0);
{ re-draw the control as in RestState : }
                            SetCtlValue(theControl, MenuReturnState);
                            HLock(theControl^^.ContrlDefProc);
                            SetCRefCon(theControl, choosenItem);
                        END

{ 2.2 : SIMPLE SELECTION OF A DOUBLE-CLICKABLE CONTROL }

{ the Control is already highlighted in the "SelectState" }
                END

{ 3° : DRAGGING }

            ELSE
                BEGIN
                    GetMouse(mouse);
                    where := FindControl(mouse, FrontWindow, theTrash);
                    HLock(GetResource('CDEF', 128));
                    IF (theTrash <> NIL) THEN

{ 3.1 : THROWING THE CONTROL AWAY IN A TRASH }

                        IF BitTst(pointer(theTrash^), varCodeBase - trashBit) AND (theTrash <> theControl) THEN
                            BEGIN
{ return "theTrash" in CRefCon }
{ without re-drawing it }
                                SetCRefCon(theControl, ord(theTrash));
                                SetCtlValue(theControl, ThrownAwayState);
                                HLock(theControl^^.ContrlDefProc);
                            END;

{ 3.2 : MOVING }

                    IF (GetCtlValue(theControl) <> ThrownAwayState) THEN
                        BEGIN
                            WITH theControl^^.ContrlRect DO
                                theHalfLength := (right - left) DIV 2;

{ move the control without showing it : }

                            HideControl(theControl);
                            HLock(theControl^^.ContrlDefProc);
                            WITH IconCenter DO
                                MoveControl(theControl, h - theHalfLength, v - 16);
                            HLock(theControl^^.ContrlDefProc);
                            theControl^^.ContrlValue := RestState;

{ the UpDate mechanism will do the re-drawing }
{ in such a way it lets the prealably hidden controls appear : }

                            SavedClip := NewRgn;
                            GetClip(SavedClip);
                            SetEmptyRgn(theGrafPort^.ClipRgn);
                            ShowControl(theControl);
                            HLock(theControl^^.ContrlDefProc);
                            SetClip(SavedClip);
{ re-use an initialised region for another purpose : }
                            UpDateRegion := SavedClip;
{ send the CalCRgns message to calculate UpDateRegion : }
                            dummy := Main(0, theControl, calcCRgns, ord4(UpDateRegion));
                            EraseRgn(UpDateRegion);
                            InValRgn(UpDateRegion);
                            DisposeRgn(UpDateRegion);
                        END;
                END;
            Main := 0;
        END;

        PROCEDURE DoInitCntl;
            VAR
                myDataHandle : DataHandle;
                theTitle : Str255;
        BEGIN
            GetCTitle(theControl, theTitle);
            myDataHandle := DataHandle(NewHandle(sizeof(DataRecord)));
            HLock(handle(myDataHandle));
            WITH myDataHandle^^ DO
                BEGIN
                    theIcon := GetNamedResource('ICN#', theTitle);
{ Initialisation should have called "GetMenu" : }
                    theMenu := MenuHandle(GetNamedResource('MENU', theTitle));
                END;
            HUnLock(handle(myDataHandle));
            WITH theControl^^ DO
                BEGIN
                    ContrlAction := pointer(-1);
                    ContrlData := handle(myDataHandle);
                END;
        END;

        PROCEDURE DoDispCntl;
        BEGIN
            DisposHandle(theControl^^.ContrlData);
        END;

    BEGIN            { Main procedure }
        CASE message OF
            drawCntl :
                DoDrawCntl;
            testCntl :
                DoTestCntl;
            calcCRgns :
                DoCalcCRgns;
            initCntl :
                DoInitCntl;
            dispCntl :
                DoDispCntl;
            dragCntl :    { for a smoother interface }
                BEGIN
                    DoAutoTrack;
                    Main := 1;    { to tell the Control Manager not to use the standard method }
                END;
            autoTrack :
                DoAutoTrack;
            OTHERWISE        { dragCntl, posCntl , thumbCntl }
                main := 0;
        END;
    END;

END.